perm filename ACCEL.F4[LX,LCS] blob sn#164490 filedate 1975-06-13 generic text, type T, neo UTF8
	SUBROUTINE ACCEL
	COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
	1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),COPY(30),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,JED,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD
C  /C/=26
      IF(T5.EQ.1)GO TO 4020
7020  RA=V(IA+K)
      IF(RA.EQ.10000.)RETURN
4020  RD=1  
      IF(RA.LT.0)RD=-1. 
      RA=RA*RD    
      IF(KA.EQ.0)RA=RA-RC     
      W=RA  
      RB=W  
      IF(W.LE.Z)GO TO 2020    
      IF(Z.NE.0)GO TO 3020    
      RA=RA/Y     
      RB=-1.
      RC=0  
      GO TO 8020  
3020      W=Z     
      RC=W+RC     
      GO TO 24    
2020      RC=0    
24	IF(X.NE.Y)GO TO 424
	RA=W/X
	GO TO 8020
C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
C   BG TIME OF NOTE. CHN=TBG.
424	RAX=XT(J)
	RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
	XT(J)=RAX+YY*RA
8020      IF(KA.EQ.0)RA=RA+PR 
      KA=1  
      IF(RC.NE.0)GO TO 1011   
      IF(T5.EQ.1)RETURN
C  T5=1 IN 'RUNIT'
      V(IA+K)=RA*RD     
      IF(K.EQ.IZ)RETURN     
C*********** JUNE 1,71
1011      IF(T5.EQ.1)GO TO 2011     
      K=K+1 
      IF(ZZ.NE.0)Z=Z-W  
      IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020     
      IC=IC+1     
      IF(RB.EQ.W)RETURN
      KA=0  
      K=K-1 
      RETURN
2011      PR=RA   
	IF(K.GT.1)GO TO 9020
	K=I-6
      ZPAR=-9900.-CHN-ZZ
      DO 3011 KL=8,I     
      IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020    
3011      K=K-1
9020      W=ZZ  
	IF(V(K+3))K=K+3
C   ABOVE IS FOR TYPED IN TEMPO CHANGES
	KA=K+3
      ZZ=V(KA)
C   DUR OF NEXT TEMPI
	X=V(KA+1)
	Y=V(KA+2)
213      KA=0  
      Z=ZZ  
	CALL SQYY(YY,X,Y,Z)
      CHN=CHN+W   
	XT(J)=X
      IF(KA.EQ.1)Z=0    
      RA=PR 
	KA=0
	K=K+3
	GO TO 4020
	END

	SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
	COMMON/A/ V(2000)
C  TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES:  -22=RHY  -33=NOTES  -44=NUMS  -46=RLIST  -36=RNOTES
C   -11=SUBN  -12=SUBR  -55=MOVE NUMS  -56=MOVE NOTES
C  -66=DUPL   -88=LIT  -57=MOVE RANGE NUMS  -58=MOVE RNG NOTES
	DO 1 K=1,2000
	N=V(K)
	IF(N.LT.10000)GO TO 1
	IF(N/10000.NE.INUM)GO TO 1
	IF(MOD(N,10000).NE.IPAR)GO TO 1
	ISTRT=K+4
	KODE=V(K+2)
	ICNT=V(K+3)
	IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
	RETURN
C  FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1	CONTINUE
	END